home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 041-050 / amok50 / brushtooberon / brushtooberon.mod < prev    next >
Text File  |  1993-11-04  |  16KB  |  512 lines
  1. (*---------------------------------------------------------------------------
  2. :Program.       BrushToOberon.mod
  3. :Contents.      Converts IFF brushes to oberon source code
  4. :Author.        Christian Stiens
  5. :Address.       Heustiege 2, W-4710 Lüdinghausen
  6. :Copyright.     PD
  7. :Language.      Oberon
  8. :Translator.    Amiga Oberon V1.17.1 A+L
  9. :History.       V1.0, 07-Mar-91
  10. :Usage.         BrushToOberon {[-i|-s|-p|-d] <iff-file>} TO <source-file>
  11. ---------------------------------------------------------------------------*)
  12.  
  13. MODULE BrushToOberon;
  14.  
  15.   (* $NilChk- $CaseChk- $ReturnChk- $OvflChk- $RangeChk- $StackChk- *)
  16.  
  17.   IMPORT
  18.     a  : Arguments,
  19.     s  : SYSTEM,
  20.     g  : Graphics,
  21.     fs : FileSystem,
  22.     st : Strings,
  23.     e  : Exec,
  24.     c  : Conversions,
  25.     ol : OberonLib,
  26.     io;
  27.  
  28.   CONST (* Error messages *)
  29.     writeerr = "Write error\n";
  30.     readerr  = "Read error\n";
  31.     nomem    = "Out of memory\n";
  32.     badIFF   = "Bad IFF format\n";
  33.     noinput  = "Can't open input file\n";
  34.     nooutput = "Can't open output file\n";
  35.     usage    = "Usage: BrushToOberon {[-i|-s|-p|-d] <iff-file>} TO <source-file>\n";
  36.  
  37.   CONST  (* Masking *)
  38.     mskNone    = 0;
  39.     mskHasMask = 1;
  40.     mskHasTransparentColor = 2;
  41.     mskLasso   = 3;
  42.  
  43.   CONST (* Compression *)
  44.     cmpNone    = 0;
  45.     cmpByteRun = 1;
  46.  
  47.   TYPE
  48.     BitMapHeader = STRUCT
  49.       width,height          : INTEGER;
  50.       x,y                   : INTEGER;
  51.       nPlanes               : SHORTINT;
  52.       masking               : SHORTINT;
  53.       compression           : SHORTINT;
  54.       pad1                  : SHORTINT;
  55.       transparentColor      : INTEGER;
  56.       xAspect,yAspect       : SHORTINT;
  57.       pageWidth,pageHeight  : INTEGER;
  58.     END;
  59.  
  60.   CONST (* Action *)
  61.     copy   = 0;
  62.     extend = 1;
  63.     nop    = 2;
  64.  
  65.   VAR
  66.     bm          : g.BitMap;
  67.     wordPtr     : POINTER TO INTEGER;
  68.     bytePtr     : POINTER TO SHORTINT;
  69.     arg,name    : ARRAY 80 OF CHAR;
  70.     modname     : ARRAY 80 OF CHAR;
  71.     argNr       : INTEGER;
  72.     wordStr     : ARRAY 8 OF CHAR;
  73.     in,out      : fs.File;
  74.     chunk,id,len: LONGINT;
  75.     buf         : POINTER TO BYTE;
  76.     bmhd        : BitMapHeader;
  77.     bmhdFlag    : BOOLEAN;
  78.     maskPlane   : INTEGER;
  79.     sprite,proc : BOOLEAN;
  80.     wordsPerLine: INTEGER;
  81.     size        : LONGINT;
  82.     x,y,z,i,col : INTEGER;
  83.     numArgs     : INTEGER;
  84.     compressed  : BOOLEAN;
  85.     zaehler     : INTEGER;
  86.     store,action: SHORTINT;
  87.  
  88.   CONST
  89.     iconSize =  781;
  90.  
  91.   PROCEDURE * IconData; (* $EntryExitCode- *)
  92.   BEGIN s.INLINE(
  93.     0E310H,00001H,00000H,00000H,000CCH,0000CH,0002AH,0001BH,00006H,00001H,
  94.     00001H,000C1H,0B6A0H,000C1H,0B778H,00004H,099A6H,00000H,00000H,00000H,
  95.     00000H,00064H,00000H,00001H,0045CH,000C1H,0B5B0H,00000H,00000H,08000H,
  96.     00000H,08000H,00000H,00000H,00000H,00000H,00000H,00000H,00000H,00000H,
  97.     00000H,0002AH,0001BH,00002H,00001H,09B30H,00300H,00000H,00000H,00FFFH,
  98.     0FFFFH,0FC00H,01000H,00000H,01200H,01000H,00000H,01200H,017FFH,09FF0H,
  99.     01200H,01000H,00000H,01C00H,01673H,0C000H,01000H,01000H,00000H,01000H,
  100.     017B9H,09F80H,01000H,01000H,00000H,01000H,01667H,00000H,01000H,01000H,
  101.     00000H,01000H,017FFH,03C00H,01000H,01000H,00000H,01000H,01700H,00000H,
  102.     01000H,01000H,00000H,01000H,0139CH,0C000H,01000H,01000H,00000H,01000H,
  103.     010E7H,0C000H,01000H,01000H,00000H,01000H,01380H,00000H,01000H,01000H,
  104.     00000H,01000H,07FFFH,0FFFFH,0D000H,08000H,00000H,09000H,08000H,00000H,
  105.     09000H,08000H,00000H,09000H,07FFFH,0FFFFH,0E000H,00000H,00000H,00000H,
  106.     00000H,00000H,00000H,00FFFH,0FFFFH,0EC00H,00FFFH,0FFFFH,0EC00H,00800H,
  107.     0600FH,0EC00H,00FFFH,0FFFFH,0E000H,0098CH,03FFFH,0E000H,00FFFH,0FFFFH,
  108.     0E000H,00846H,0607FH,0E000H,00FFFH,0FFFFH,0E000H,00998H,0FFFFH,0E000H,
  109.     00FFFH,0FFFFH,0E000H,00800H,0C3FFH,0E000H,00FFFH,0FFFFH,0E000H,008FFH,
  110.     0FFFFH,0E000H,00FFFH,0FFFFH,0E000H,00C63H,03FFFH,0E000H,00FFFH,0FFFFH,
  111.     0E000H,00F18H,03FFFH,0E000H,00FFFH,0FFFFH,0E000H,00C7FH,0FFFFH,0E000H,
  112.     00FFFH,0FFFFH,0E000H,00000H,00000H,02000H,07FFFH,0FFFFH,06000H,07FFFH,
  113.     0FFFFH,06000H,07FFFH,0FFFFH,06000H,00000H,00000H,00000H,00000H,00000H,
  114.     00000H,00000H,00000H,0002AH,0001BH,00002H,00001H,09C78H,00300H,00000H,
  115.     00000H,00FFFH,0FFFFH,0FC00H,01000H,00000H,01200H,01000H,00000H,01200H,
  116.     017FFH,09FF0H,01200H,01000H,00000H,01C00H,01673H,0C000H,01000H,01000H,
  117.     00000H,01000H,017B9H,09F80H,01000H,01000H,00000H,01000H,01667H,00000H,
  118.     01000H,01000H,00080H,01000H,017FFH,03C78H,01000H,01000H,0007EH,01000H,
  119.     01700H,0007FH,01000H,01000H,0007CH,09000H,0139CH,0C074H,05000H,01000H,
  120.     00022H,03000H,010E7H,0C011H,01000H,01000H,00008H,08800H,01380H,00004H,
  121.     04400H,01000H,00002H,02200H,07FFFH,0FFFFH,01100H,08000H,00000H,08880H,
  122.     08000H,00000H,0C480H,08000H,00000H,06380H,07FFFH,0FFFFH,0FE00H,00000H,
  123.     00000H,00000H,00000H,00000H,00000H,00FFFH,0FFFFH,0EC00H,00FFFH,0FFFFH,
  124.     0EC00H,00800H,0600FH,0EC00H,00FFFH,0FFFFH,0E000H,0098CH,03FFFH,0E000H,
  125.     00FFFH,0FFFFH,0E000H,00846H,0607FH,0E000H,00FFFH,0FFFFH,0E000H,00998H,
  126.     0FFFFH,0E000H,00FFFH,0FF7FH,0E000H,00800H,0C39FH,0E000H,00FFFH,0FFFDH,
  127.     0E000H,008FFH,0FFF8H,0E000H,00FFFH,0FFE3H,06000H,00C63H,03F8BH,0A000H,
  128.     00FFFH,0FFDDH,0C000H,00F18H,03FEEH,0E000H,00FFFH,0FFF7H,07000H,00C7FH,
  129.     0FFFBH,0B800H,00FFFH,0FFFDH,0DC00H,00000H,00000H,0EE00H,07FFFH,0FFFFH,
  130.     07700H,07FFFH,0FFFFH,03B00H,07FFFH,0FFFFH,09C00H,00000H,00000H,00000H,
  131.     00000H,00000H,00000H,00000H,0000BH,04F42H,04552H,04F4EH,03A4FH,04564H,
  132.     00000H)
  133.   END IconData;
  134.  
  135.   PROCEDURE Read(VAR to: ARRAY OF BYTE);
  136.   BEGIN
  137.     IF NOT fs.Read(in,to) THEN
  138.       io.WriteString(readerr);
  139.       HALT(0)
  140.     END;
  141.   END Read;
  142.  
  143.   PROCEDURE WriteString(str: ARRAY OF CHAR); (* $CopyArrays- *)
  144.   BEGIN
  145.     IF NOT fs.WriteBlock(out,s.ADR(str),st.Length(str)) THEN
  146.       io.WriteString(writeerr);
  147.       HALT(0)
  148.     END;
  149.   END WriteString;
  150.  
  151.   PROCEDURE WriteInt(i: LONGINT);
  152.     VAR str : ARRAY 40 OF CHAR;
  153.         j   : LONGINT;
  154.         n   : SHORTINT;
  155.   BEGIN
  156.     j := i; n := 1;
  157.     WHILE j >= 10 DO j := j DIV 10; INC(n) END;
  158.     IF c.IntToStr(i,str,10,n," ") THEN WriteString(str) END;
  159.   END WriteInt;
  160.  
  161.   PROCEDURE Tab(n: LONGINT);
  162.     VAR str : ARRAY 10 OF CHAR;
  163.   BEGIN
  164.     str := "          ";
  165.     IF n<10 THEN str[n] := 0X END;
  166.     WriteString(str);
  167.   END Tab;
  168.  
  169.   PROCEDURE IffErr;
  170.   BEGIN
  171.     io.WriteString(badIFF); HALT(0)
  172.   END IffErr;
  173.  
  174.   PROCEDURE Usage;
  175.   BEGIN
  176.     io.WriteString(usage); HALT(0)
  177.   END Usage;
  178.  
  179.   PROCEDURE NextWord():INTEGER;
  180.     VAR uword : INTEGER;
  181.         ubyte : SHORTINT;
  182.         bytes : INTEGER;
  183.         n     : SHORTINT;
  184.   BEGIN
  185.     IF NOT compressed THEN
  186.       Read(uword);
  187.       RETURN uword
  188.     END;
  189.     uword := 0; bytes := 0;
  190.     REPEAT
  191.       IF zaehler=0 THEN
  192.         Read(n);
  193.         IF n >= 0 THEN
  194.           zaehler := n+1;
  195.           action := copy;
  196.         ELSIF n # -128 THEN
  197.           zaehler:= (-n)+1;
  198.           action := extend;
  199.           Read(store);
  200.         ELSE
  201.           action := nop;
  202.         END;
  203.       ELSE
  204.         CASE action OF
  205.         | copy:   Read(ubyte);
  206.         | extend: ubyte := store
  207.         | nop:
  208.         END;
  209.         (* $OvflChk- *)
  210.         uword := s.LSH(uword,8);
  211.         IF ubyte >= 0 THEN
  212.           uword := uword + ubyte
  213.         ELSE
  214.           uword := uword + (LONG(ubyte)+256)
  215.         END;
  216.         (* $OvflChk= *)
  217.         DEC(zaehler);
  218.         INC(bytes);
  219.       END;
  220.     UNTIL bytes=2;
  221.     RETURN uword;
  222.   END NextWord;
  223.  
  224.   PROCEDURE Letter(ch:CHAR):BOOLEAN;
  225.   BEGIN
  226.     RETURN (CAP(ch) >="A") & (CAP(ch) <= "Z") OR (ch >="0") & (ch <= "9")
  227.   END Letter;
  228.  
  229.   PROCEDURE ExtractName(VAR str: ARRAY OF CHAR);  (* dev:name.ext -> Name *)
  230.     VAR i,j,k:INTEGER;
  231.   BEGIN
  232.     i:=st.Length(str);
  233.     LOOP
  234.       DEC(i); IF (i<0) OR (str[i]=":") OR (str[i]="/") THEN EXIT END;
  235.     END; j:=i;
  236.     LOOP
  237.       INC(j);
  238.       IF (j >= st.Length(str)) OR ~Letter(str[j]) THEN EXIT END
  239.     END; k:=0;
  240.     LOOP
  241.       INC(i); IF i=j THEN EXIT END;
  242.       str[k] := str[i]; INC(k);
  243.     END;
  244.     IF k < LEN(str) THEN str[k]:=0X END;
  245.     str[0] := CAP(str[0]);
  246.   END ExtractName;
  247.  
  248.   PROCEDURE CreateBitMap;
  249.     VAR i: INTEGER;
  250.   BEGIN
  251.     g.InitBitMap(bm,bmhd.nPlanes,bmhd.width,bmhd.height);
  252.     i := 0; WHILE i < s.VAL(SHORTINT,bm.depth)+maskPlane DO
  253.       INCL(ol.MemReqs,e.chip);
  254.       ol.New(bm.planes[i],bm.bytesPerRow*bm.rows);
  255.       EXCL(ol.MemReqs,e.chip);
  256.       IF bm.planes[i] = NIL THEN
  257.         io.WriteString(nomem);
  258.         HALT(0)
  259.       END;
  260.     INC(i) END;
  261.   END CreateBitMap;
  262.  
  263.   PROCEDURE FreeBitMap;
  264.     VAR i: INTEGER;
  265.   BEGIN
  266.     i := 0; WHILE i < s.VAL(SHORTINT,bm.depth)+maskPlane DO
  267.       IF bm.planes[i] # NIL THEN ol.Dispose(bm.planes[i]) END;
  268.     INC(i) END
  269.   END FreeBitMap;
  270.  
  271.   PROCEDURE OpenOutFile(VAR numArgs: INTEGER);
  272.     VAR n : INTEGER;
  273.   BEGIN
  274.     n := 1;
  275.     WHILE n < a.NumArgs() DO
  276.       a.GetArg(n,arg); st.Upper(arg);
  277.       IF arg = "TO" THEN
  278.         a.GetArg(n+1,name);
  279.         IF fs.Open(out,name,TRUE) THEN
  280.           io.WriteString("Creating file ");
  281.           io.WriteString(name);
  282.           io.WriteString(" ...\n");
  283.           WriteString("MODULE ");
  284.           COPY(name,modname);
  285.           ExtractName(modname);
  286.           WriteString(modname);
  287.           WriteString("; (* $CodeChip+ $DataChip+ *)\n\n");
  288.           WriteString("IMPORT sys: SYSTEM;\n\n");
  289.           numArgs := n-1;
  290.           RETURN
  291.         ELSE
  292.           io.WriteString(nooutput); HALT(0)
  293.         END;
  294.       END;
  295.       INC(n);
  296.     END;
  297.     Usage;
  298.   END OpenOutFile;
  299.  
  300. BEGIN
  301.   proc := FALSE;  sprite := FALSE;
  302.   a.GetArg(1,arg);
  303.   IF (a.NumArgs() = 0) OR (arg[0]="?") THEN Usage END;
  304.   OpenOutFile(numArgs);
  305.   argNr := 1;
  306.   WHILE argNr <= numArgs DO
  307.     a.GetArg(argNr,arg);
  308.  
  309.     IF arg[0] = "-" THEN                   (* arg is option *)
  310.  
  311.       i := 1;
  312.       WHILE i < st.Length(arg) DO
  313.         CASE CAP(arg[i]) OF
  314.         | "S": sprite := TRUE
  315.         | "I": sprite := FALSE
  316.         | "P": proc   := TRUE
  317.         | "D": proc   := FALSE
  318.         ELSE
  319.        END;
  320.        INC(i)
  321.      END;
  322.  
  323.     ELSE                                   (* arg is file *)
  324.  
  325.       IF fs.Open(in,arg,FALSE) THEN
  326.  
  327.         ExtractName(arg);
  328.  
  329.         Read(chunk); IF chunk # s.VAL(LONGINT,"FORM") THEN IffErr END;
  330.         Read(len);
  331.         Read(id);    IF id # s.VAL(LONGINT,"ILBM") THEN IffErr END;
  332.         zaehler := 0;
  333.         bmhdFlag := FALSE;
  334.  
  335.         LOOP
  336.           Read(chunk);  Read(len);
  337.           IF ODD(len) THEN INC(len) END;
  338.  
  339.           IF chunk = s.VAL(LONGINT,"BODY") THEN
  340.             IF NOT bmhdFlag THEN IffErr END;
  341.  
  342.             wordsPerLine := (bmhd.width+15) DIV 16;
  343.             compressed   := (bmhd.compression=cmpByteRun);
  344.             IF bmhd.masking=mskHasMask THEN
  345.               maskPlane := 1
  346.             ELSE
  347.               maskPlane := 0
  348.             END;
  349.             size := wordsPerLine * bmhd.height * bmhd.nPlanes;
  350.  
  351.             CreateBitMap;
  352.  
  353.             y := 0; WHILE y < bm.rows DO
  354.               z := 0; WHILE z < s.VAL(SHORTINT,bm.depth)+maskPlane DO
  355.                 wordPtr := bm.planes[z] + y * bm.bytesPerRow;
  356.                 x := 0; WHILE x < wordsPerLine DO
  357.                   wordPtr^ := NextWord();
  358.                   INC(wordPtr,2);
  359.                 INC(x) END;
  360.               INC(z) END;
  361.             INC(y) END;
  362.  
  363.             WriteString("CONST "); WriteString(arg); WriteString("Size * = ");
  364.             WriteInt(size * 2); WriteString("; (* ");
  365.             WriteInt(bmhd.width);  WriteString(" x ");
  366.             WriteInt(bmhd.height); WriteString(" x ");
  367.             WriteInt(bmhd.nPlanes);
  368.             WriteString(" *)\n\n");
  369.  
  370.             IF proc THEN
  371.               WriteString("PROCEDURE "); WriteString(arg);
  372.               WriteString("Data * ; (* $EntryExitCode- *)\n");
  373.               WriteString("BEGIN sys.INLINE(\n");
  374.             ELSE
  375.               WriteString("TYPE IntArray"); WriteInt(size);
  376.               WriteString(" = ARRAY "); WriteInt(size);
  377.               WriteString(" OF INTEGER;\n\n");
  378.  
  379.               WriteString("CONST ");
  380.               WriteString(arg); WriteString("Data * = IntArray");
  381.               WriteInt(size); WriteString("(\n");
  382.             END;
  383.  
  384.             IF sprite THEN
  385.  
  386.               y := 0; WHILE y < bm.rows DO
  387.                 Tab(2);
  388.                 z := 0; WHILE z < s.VAL(SHORTINT,bm.depth) DO
  389.                   wordPtr := bm.planes[z] + y * bm.bytesPerRow;
  390.                   x := 0; WHILE x < wordsPerLine DO
  391.                     IF c.IntToHex(wordPtr^,wordStr,5) THEN END;
  392.                     wordStr[0] := "0";
  393.                     IF ~proc THEN wordStr[5] := "U" END;
  394.                     WriteString(wordStr);
  395.                     IF (z+1=s.VAL(SHORTINT,bm.depth))&(y+1=bm.rows)&(x+1=wordsPerLine) THEN
  396.                       WriteString(");")
  397.                     ELSE
  398.                       WriteString(",")
  399.                     END;
  400.                     INC(wordPtr,2);
  401.                   INC(x) END;
  402.                 INC(z) END;
  403.                 WriteString("\n");
  404.               INC(y) END;
  405.  
  406.             ELSE
  407.  
  408.               z := 0; WHILE z < s.VAL(SHORTINT,bm.depth) DO
  409.                 y := 0; WHILE y < bm.rows DO
  410.                   wordPtr := bm.planes[z] + y * bm.bytesPerRow;
  411.                   Tab(2);
  412.                   x := 0; WHILE x < wordsPerLine DO
  413.                     IF c.IntToHex(wordPtr^,wordStr,5) THEN END;
  414.                     wordStr[0] := "0";
  415.                     IF ~proc THEN wordStr[5] := "U" END;
  416.                     WriteString(wordStr);
  417.                     IF (z+1=s.VAL(SHORTINT,bm.depth))&(y+1=bm.rows)&(x+1=wordsPerLine) THEN
  418.                       WriteString(");")
  419.                     ELSE
  420.                       WriteString(",")
  421.                     END;
  422.                     INC(wordPtr,2);
  423.                   INC(x) END;
  424.                   WriteString("\n");
  425.                 INC(y) END;
  426.               INC(z) END;
  427.  
  428.             END; (* IF *)
  429.  
  430.             IF proc THEN
  431.               WriteString("END ");
  432.               WriteString(arg);
  433.               WriteString("Data;\n\n");
  434.             ELSE
  435.               WriteString("\n\n");
  436.             END;
  437.  
  438.             FreeBitMap;
  439.  
  440.             EXIT;
  441.           END;
  442.           buf := e.AllocMem(len,LONGSET{e.public});
  443.           IF buf # NIL THEN
  444.             IF NOT fs.ReadBlock(in,buf,len) THEN
  445.               io.WriteString(readerr); HALT(0)
  446.             END;
  447.  
  448.             IF chunk = s.VAL(LONGINT,"BMHD") THEN
  449.  
  450.               e.CopyMem(buf^,bmhd,s.SIZE(bmhd));
  451.               bmhdFlag := TRUE;
  452.  
  453.             ELSIF chunk = s.VAL(LONGINT,"CMAP") THEN
  454.  
  455.               size := len DIV 3;
  456.  
  457.               WriteString("TYPE IntArray"); WriteInt(size);
  458.               WriteString(" = ARRAY ");       WriteInt(size);
  459.               WriteString(" OF INTEGER;\n\n");
  460.               WriteString("CONST ");
  461.               WriteString(arg); WriteString("Cols * = IntArray");
  462.               WriteInt(size); WriteString("(\n");
  463.  
  464.               col := 0;
  465.               bytePtr := s.VAL(LONGINT,buf);
  466.               x := 0;
  467.               WHILE x < len DO
  468.                 INC(x);
  469.                 col := s.LSH(col,4) + s.LSH(bytePtr^,-4);
  470.                 INC(bytePtr);
  471.  
  472.                 IF x MOD 3 = 0 THEN
  473.                   IF c.IntToHex(col,wordStr,4) THEN END;
  474.                   wordStr[0] := "0";
  475.                   Tab(2);
  476.                   WriteString(wordStr);
  477.                   IF x+3 <= len THEN
  478.                     WriteString(",")
  479.                   ELSE
  480.                     WriteString(");\n")
  481.                   END;
  482.                   WriteString("\n");
  483.                   col := 0;
  484.                 END;
  485.               END;
  486.  
  487.             END;
  488.             e.FreeMem(buf,len);
  489.           ELSE
  490.             io.WriteString(nomem);
  491.             HALT(0)
  492.           END; (* IF buf # NIL *)
  493.         END; (* LOOP *)
  494.         IF fs.Close(in) THEN END;
  495.       ELSE
  496.         io.WriteString(noinput);
  497.       END; (* IF fs.Open *)
  498.     END; (* IF arg[0] = "-" *)
  499.     INC(argNr);
  500.   END; (* WHILE *)
  501.  
  502.   WriteString("END "); WriteString(modname); WriteString(".\n");
  503.   IF fs.Close(out) THEN END;  (* Empty buffer & close file *)
  504.   st.Append(name,".info");
  505.   IF fs.Open(out,name,TRUE) &
  506.      fs.WriteBlock(out,IconData,iconSize) &
  507.      fs.Close(out) THEN
  508.   END;
  509.   io.WriteString("--- Done\n");
  510. END BrushToOberon.
  511.  
  512.